#!/usr/bin/perl -wc

package RFCMail::ESMTP::Server::Salvage::Envelope;

use strict;
use RFCMail::ESMTP::Grammar::Base qw(MAIL_ARGS_RE
				     RCPT_ARGS_RE
				     REVERSE_PATH_RE
				     FORWARD_PATH_RE
				     PARAMETERS_RE
				     MAILBOX_RE);


sub init {
    my $self = shift;
    $self->SUPER::init(@_);
    if (not exists($self->{salvage_envelope}) or $self->{salvage_envelope}) {
	my $any_re = qr'\A(.+)\z';
	$self->{handlers}->set('MAIL', $any_re, 'mail_salvager');
	$self->{handlers}->set('RCPT', $any_re, 'rcpt_salvager');
    }
}


sub mail_salvager {
    my $self = shift;
    my $cmd = shift;
    local $_ = shift;
    my @mail_args = eval {
	my @x;
	@x = /@{[MAIL_ARGS_RE]}/o;
	return (@x) if @x;
	$self->logmsg(i => "arguments to $cmd not valid: attempting salvage");
	@x = /\A(?i:\s*FROM:\s*)(@{[REVERSE_PATH_RE]})(?:\s+(@{[PARAMETERS_RE]}))?\z/o;
	if (@x) {
	    $self->logmsg(i => 'error recognised: illegal whitespace ignored');
	    return (@x);
	}
	@x = /(@{[REVERSE_PATH_RE]})/o;
	if (@x) {
	    $self->logmsg(i => "found a path-like construct; assuming MAIL From:@x");
	    return (@x);
	}
	@x = /(@{[MAILBOX_RE]})/o;
	if (@x) {
	    $self->logmsg(i => "found a mailbox-like construct; assuming MAIL From:<@x>");
	    return ("<@x>");
	}
	$self->logmsg(i => 'salvage of MAIL command not possible');
	return ();
    };
    return ([501, 'Arguments to MAIL invalid beyond recovery'])
	if not @mail_args;
    return ($self->mail_handler($cmd, @mail_args));
}


sub rcpt_salvager {
    my $self = shift;
    my $cmd = shift;
    local $_ = shift;
    my @rcpt_args = eval {
	my @x;
	@x = /@{[RCPT_ARGS_RE]}/o;
	return (@x) if @x;
	$self->logmsg(i => "arguments to $cmd not valid: attempting salvage");
	@x = /\A(?i:\s*TO:\s*)(@{[FORWARD_PATH_RE]})(?:\s+(@{[PARAMETERS_RE]}))?\z/o;
	if (@x) {
	    $self->logmsg(i => 'error recognised: illegal whitespace ignored');
	    return (@x);
	}
	@x = /(@{[FORWARD_PATH_RE]})/o;
	if (@x) {
	    $self->logmsg(i => "found a path-like construct; assuming RCPT To:@x");
	    return (@x);
	}
	@x = /(@{[MAILBOX_RE]})/o;
	if (@x) {
	    $self->logmsg(i => "found a mailbox-like construct; assuming RCPT To:<@x>");
	    return ("<@x>");
	}
	$self->logmsg(i => 'salvage of RCPT command not possible');
	return ();
    };
    return ([501, 'Arguments to RCPT invalid beyond recovery'])
	if not @rcpt_args;
    return ($self->rcpt_handler($cmd, @rcpt_args));
}


1;
